home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0187.ZIP / TELEPHON.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-20  |  5KB  |  155 lines
  1. program telephone;
  2.  
  3. const
  4.    lettersperdigit =  3;    (* each number can have 3 letters *)
  5.    maxnumlength    = 10;    (* allows long distance numbers   *)
  6.    maxconsonants   =  3;    (* maximum number of consonants   *)
  7.                             (* that are allowed in a word, if *)
  8.                             (* there are more than this many  *)
  9.                             (* the rest of the combinations   *)
  10.                             (* with this root are skipped     *)
  11.  
  12. type
  13.    digitslet = array[1..lettersperdigit] of char;
  14.  
  15. var
  16.    dial      : array['0'..'9'] of digitslet;
  17.    vowels    : set of 'A'..'Z';
  18.    phonenum  : string[10];
  19.    word      : packed array [1..maxnumlength] of char;
  20.    numlength : integer;
  21.  
  22. (*
  23.  * initializes the array dial to contain the same (digit, 3 letters)
  24.  * groups that are on telephones. 0 and 1 do not have any, and are set
  25.  * to blank. the rest of the numbers are mapped to succeeding triples
  26.  * of letters ( 2 -> A,B,C). the exception to this is that the letter
  27.  * Q is ignored, making the triple for 7 to be P,R,S.
  28.  *)
  29.  
  30. procedure setupdial;
  31.  
  32. var
  33.    i      : integer;
  34.    digit  : char;
  35.    letter : char;
  36.  
  37. begin
  38.    for digit := '0' to '1' do
  39.       for  i := 1 to lettersperdigit do
  40.          dial[digit][i] := ' ';
  41.    letter := 'A';
  42.    for digit := '2' to '9' do
  43.       for i := 1 to lettersperdigit do
  44.          begin
  45.          if letter = 'Q' then
  46.             letter := succ(letter);
  47.          dial[digit][i] := letter;
  48.          letter := succ(letter);
  49.          end;
  50. end;
  51.  
  52. (*
  53.  * enoughvowels applies a simple test to the word to find out if it is
  54.  * pronounceable
  55.  *)
  56.  
  57. function enoughvowels(sofar:integer):boolean;
  58.  
  59. var
  60.    posinword, lastvowel : integer;
  61.  
  62. begin
  63.    lastvowel := 0;
  64.    enoughvowels := true;
  65.    if sofar > maxconsonants then
  66.       for posinword := 1 to sofar do
  67.          begin
  68.          if word[posinword] in vowels then
  69.             lastvowel := posinword
  70.          else if posinword - lastvowel > maxconsonants then
  71.             enoughvowels := false;
  72.          end;
  73. end;
  74.  
  75. (*
  76.  * this is a recursive procedure which prints all possible combinations
  77.  * of letters for the digits in the given phone number. given a position in
  78.  * the number at which to continue looking, it loops through all the
  79.  * possible values of the current position's letter (determined by the
  80.  * corresponding letters for that digit on a telephone dial). for each
  81.  * letter, it calls itself recursively on the next position in the number
  82.  * (to figure out the next letter). the end of the number is reached
  83.  * when the position would extend past the end of the string; then the current
  84.  * permutation is printed and it returns to get the next combination.
  85.  *)
  86.  
  87. procedure permutate(position:integer);
  88.  
  89. var
  90.    i : integer;
  91.  
  92. begin
  93.    if keypressed then
  94.       halt;
  95.    if position > numlength then
  96.       writeln(word:numlength)
  97.    else for i := 1 to lettersperdigit do
  98.       begin
  99.       word[position] := dial[phonenum[position]][i];
  100.       if enoughvowels(position) then
  101.          permutate(position + 1);
  102.       end;
  103. end;
  104.  
  105. (*
  106.  * returns true if ch is a numerical character
  107.  *)
  108.  
  109. function isdigit (ch : char) : boolean;
  110.  
  111. begin
  112.    isdigit := (ch >= '0') and (ch <= '9');
  113. end;
  114.  
  115. (*
  116.  * determines if the string typed in might be a syntactically correct
  117.  * telephone number. it must contain digits; it may optionally have
  118.  * dashes (which are removed).
  119.  *)
  120.  
  121. function arealphonenumber : boolean;
  122.  
  123. var
  124.    digitpos : integer;
  125.  
  126. begin
  127.    arealphonenumber := true;
  128.    while pos('-',phonenum) <> 0 do
  129.       delete(phonenum,pos('-',phonenum),1);
  130.    numlength := length(phonenum);
  131.    if (numlength <= 0) or (numlength > maxnumlength) then
  132.       arealphonenumber := false
  133.    else for digitpos := 1 to numlength do
  134.       if not isdigit(phonenum[digitpos]) then
  135.          begin
  136.          arealphonenumber := false;
  137.          end;
  138. end;
  139.  
  140. begin
  141.    setupdial;
  142.    vowels := ['A','E','I','O','U','Y'];
  143.    writeln('This program finds words that match the digits in a telephone');
  144.    writeln('number. Words with more than ',maxconsonants:1,' consonants are automatically');
  145.    writeln('rejected. Numbers may have embedded dashes and may be up to ',maxnumlength:1);
  146.    writeln('digits long. Hit any key to exit before all the combinations');
  147.    writeln('have been listed.');
  148.    writeln;
  149.    repeat
  150.       write('What is your number? ');
  151.       readln(phonenum);
  152.    until arealphonenumber;
  153.    permutate(1);
  154. end.
  155.